home *** CD-ROM | disk | FTP | other *** search
/ Tech Arsenal 1 / Tech Arsenal (Arsenal Computer).ISO / tek-02 / wplay.zip / WINPLAY.PAS < prev   
Pascal/Delphi Source File  |  1991-12-17  |  11KB  |  326 lines
  1. unit WinPlay;
  2.  
  3. (*
  4. I'll make a confession that may shame me in front of my fellow 
  5. TurboPascal programmers: I used to enjoy using the Play statement in 
  6. GW-BASIC.  It provided a pretty sensible way to get a musical phrase 
  7. out of a program.  Certainly it was easier to use than TP's Sound 
  8. command, and much easier to use than the TPW Windows API calls that
  9. deal with musical notes. 
  10.  
  11. Here, then, is WinPlay, a TPW unit that emulates that BASIC command.  
  12. It makes it a snap to drop a musical phrase into a TPW program. 
  13.  
  14. The syntax is simple: just give Play() a string consisting of note
  15. names.  Optionally you can specify things like octaves, tempo, note
  16. types (like quarter, sixteenth, etc.), "music" type (like legato,
  17. staccato, and normal), and a few other goodies.
  18.  
  19. In that Play string:
  20.  
  21.         A..G  : are the note names, as if on a keyboard.
  22.         P     : means pause, or rest.
  23.         #,+   : mean sharp the immediately previous note.
  24.         -     : means flat the immediately previous note.
  25.         .     : means dot the immediately previous note.
  26.  
  27.         Tnnn  : tempo, sets the number of quarter notes in one
  28.                 minute.  Default is T120.
  29.         On    : octave, sets the current octave, 0 through 6, that the
  30.                 note names refer to.  Default is O4, where C is an
  31.                 octave above middle C.  Pitches in an octave begin at
  32.                 C and work upwards to B.
  33.         Lnn   : length, sets the duration of notes that follow. 'n'
  34.                 usually is a common note type like 8 for eighths, 4
  35.                 for quarters, 1 for whole notes, etc.  It may be any
  36.                 number.  Musician friends will giggle at you if you
  37.                 program in 15th or 57th notes.  3, 6, and 12 might
  38.                 commonly be used for triplets, though.  Default is L4.
  39.         nn    : a number following a note name or a pause means 'for
  40.                 this specific instance only, set a temporary length.'
  41.         MS
  42.         MN
  43.         ML    : "music" types of staccato, normal, or legato.
  44.                 In staccato mode, the pitch is sounded for half the
  45.                 indicated length followed by a rest of half the
  46.                 length.  In normal mode, the default, the ratio is 7/8
  47.                 to 1/8.  In legato mode, there is no articulating rest
  48.                 -- repeated notes will not be distinguishable.
  49.         >
  50.         <      : shorthand indicators to change up or down from the
  51.                  current octave.
  52.  
  53. (A few commands from BASIC are not supported: N, X, V, MF, and MB.)
  54.  
  55. Case of the letters makes no difference.  Embedded spaces, which can 
  56. make things much more readable, are ignored.
  57.  
  58. This simple example will play a G major scale starting in default 
  59. octave 4, at default quarter-note length, at default 120 tempo:
  60.  
  61.         Play ('gab>cdef#g');
  62.  
  63. Careful perusal of the accompanying file, CELLO.PAS, a setting of a 
  64. movement from the Bach G Major Solo Suite for 'cello, will show all 
  65. the tricks in use. 
  66.  
  67. The following source code is pretty liberally commented with some 
  68. oddities about using the Windows API sound functions. *)
  69.  
  70.  
  71. interface
  72. procedure Play (PlayString : string);
  73.  
  74.  
  75.  
  76. implementation
  77. uses WinProcs, WinCRT;
  78.  
  79. const Magic : integer=376;
  80.         (*
  81.         Magic is used as a multiplier to determine the duration of a 
  82.         note.  The Windows API documentation for setVoiceSound
  83.         indicates that duration should be a straight forward
  84.         calculation of yea-so-many clock ticks.  It just isn't so.
  85.         Brute force experimentation found 376.  It seems to work fine
  86.         regardless of processor speed or whatever.  I've tested on
  87.         386/33, 386/16, and 8088/4.7 machines -- they all work.  Let
  88.         me tell you, it was sure fun setting up and running Windows on
  89.         that 8088/4.7 CGA equipment. *)
  90.  
  91.       Tempo : integer = 120;
  92.       NoteType : integer = 4;
  93.       Octave : integer = 4;
  94.       Music : char = 'N';
  95.       C : integer = 0;
  96.       D : integer = 2;
  97.       E : integer = 4;
  98.       F : integer = 5;
  99.       G : integer = 7;
  100.       A : integer = 9;
  101.       B : integer = 11;
  102.       Pause : integer = $ff;
  103.       Base : array [0..6] of integer = (1,13,25,37,49,61,73);
  104.  
  105. var   Pitch : array[0..84] of LongInt;
  106.       Herz  : array[0..11] of Real;
  107.       SemiTone,Count,Multiplier,Power : integer;
  108.       Divisor : real;
  109.  
  110.  
  111. procedure Play;
  112. var p : integer;
  113.     AddDot : Boolean;
  114.  
  115.     function GetNumber: integer;
  116.     var N,ErrorCode: integer;
  117.         S: string[4];
  118.     begin
  119.     N := 0;
  120.     S := '';
  121.     inc(p);
  122.     repeat
  123.        S := S + PlayString[p];
  124.        Inc(p);
  125.     until not (UpCase(PlayString[p]) in ['0'..'9'])
  126.           or (p > length(PlayString));
  127.     val(S,N,ErrorCode);
  128.     GetNumber := N;
  129.     dec(p);
  130.     end;
  131.  
  132.     function Duration(Tempo,NoteType : integer) : integer;
  133.     var Temp : real;
  134.     begin
  135.     Temp := 60 / Tempo * Magic * 4 / NoteType;
  136.     If AddDot then Temp := Temp + Temp / 2;
  137.     Duration := trunc(Temp);
  138.     end;
  139.  
  140.     procedure SetNote(Note : integer);
  141.     var SingleLength : boolean;
  142.         SaveNoteType : integer;
  143.     begin
  144.     SingleLength := false;
  145.     AddDot := false;
  146.  
  147.     if p<length(PlayString) then
  148.      if PlayString[p+1] in ['#','+','-'] then
  149.         begin
  150.         inc(p);
  151.         case PlayString[p] of
  152.           '#','+' : inc(Note);
  153.           '-'     : dec(Note);
  154.           end;
  155.         end;
  156.  
  157.     if p<length(PlayString) then
  158.      if PlayString[p+1] in ['0'..'9'] then
  159.         begin
  160.         SaveNoteType := NoteType;
  161.         NoteType := GetNumber;
  162.         SingleLength := true;
  163.         end;
  164.  
  165.  
  166.     if p<length(PlayString) then
  167.      if PlayString[p+1] = '.' then
  168.         begin
  169.         AddDot := true;
  170.         inc(p);
  171.         end;
  172.  
  173.     (*
  174.     The actual tone production routines follow.  If you've explored 
  175.     the API music functions at all, you may wonder why I'm using 
  176.     setVoiceSound instead of setVoiceNote.  setVoiceNote seems, on the 
  177.     surface, to be the automatic way to write these sorts of things, 
  178.     but it just doesn't work very well.  Whole notes and half notes 
  179.     are incorrectly produced, dots are impossible, and the nicety of 
  180.     having legato is gone.  setVoiceSound works much better, though it 
  181.     does require that you calculate a duration rather than just 
  182.     specifying tempo and length. *) 
  183.  
  184.     if Note = Pause then setVoiceSound(1,Pitch[0],Duration(Tempo,NoteType))
  185.     else
  186.     Case Music of
  187.     'N' : begin
  188.        setVoiceSound(1,Pitch[Base[Octave]+Note],
  189.                        Duration(Tempo,NoteType) * 7 div 8 );
  190.        setVoiceSound(1,Pitch[0],Duration(Tempo,NoteType) * 1 div 8 );
  191.        end;
  192.     'S' : begin
  193.        setVoiceSound(1,Pitch[Base[Octave]+Note],
  194.                        Duration(Tempo,NoteType) * 4 div 8 );
  195.        setVoiceSound(1,Pitch[0],Duration(Tempo,NoteType) * 4 div 8 );
  196.        end;
  197.     'L' : setVoiceSound(1,Pitch[Base[Octave]+Note],Duration(Tempo,NoteType));
  198.     end;
  199.  
  200.     if SingleLength then NoteType := SaveNoteType;
  201.     end; {SetNote}
  202.  
  203.  
  204. begin {Play main body}
  205.  
  206. repeat for p := 1 to length (PlayString) do
  207.   if PlayString[p] = ' ' then Delete (PlayString,p,1);
  208.   until pos(' ',PlayString) = 0;
  209.  
  210. OpenSound;
  211. p := 1;
  212. repeat
  213.   Case UpCase(PlayString[p]) of
  214.      'T' : Tempo := GetNumber;
  215.      'O' : Octave := GetNumber;
  216.      'L' : NoteType := GetNumber;
  217.      'M' : begin
  218.            inc(p);
  219.            Music := UpCase(PlayString[p]);
  220.            end;
  221.      'A' : SetNote(A);
  222.      'B' : SetNote(B);
  223.      'C' : SetNote(C);
  224.      'D' : SetNote(D);
  225.      'E' : SetNote(E);
  226.      'F' : SetNote(F);
  227.      'G' : SetNote(G);
  228.      'P' : SetNote(pause);
  229.      '>' : Inc(Octave);
  230.      '<' : Dec(Octave);
  231.      end;  {Case}
  232.  
  233. inc(p);
  234. until p > length (PlayString);
  235.  
  236. (*
  237. I don't know why I've got to send one last 'empty' note to the
  238. voice queue, but without it, the last real note doesn't get played.
  239. That's the purpose of the next statement. *)
  240.  
  241. setVoiceSound(1,0,1);
  242. setVoiceThreshold(1,0);
  243. StartSound;
  244.  
  245. repeat until GetThresholdStatus = 1;
  246. CloseSound;
  247.  
  248. end;
  249.  
  250. begin {WinPlay Unit initialization}
  251.  
  252. (*
  253. I found a book with the appropriate frequencies for an octave of white
  254. notes without much scouring around.  I couldn't find the black notes,
  255. so they are calculated values -- pretty close to what they should be,
  256. with just a little insult to a really critical ear for intonation. *)
  257.  
  258. Herz[C] := 523.25;
  259. Herz[D] := 587.33;
  260. Herz[E] := 659.26;
  261. Herz[F] := 698.46;
  262. Herz[G] := 783.99;
  263. Herz[A] := 880.00;
  264. Herz[B] := 987.77;
  265.  
  266. Herz[C+1] := (Herz[C]+Herz[D]) /2;
  267. Herz[D+1] := (Herz[D]+Herz[E]) /2;
  268. Herz[F+1] := (Herz[F]+Herz[G]) /2;
  269. Herz[G+1] := (Herz[G]+Herz[A]) /2;
  270. Herz[A+1] := (Herz[A]+Herz[B]) /2;
  271.  
  272. (*
  273. I was going to construct a table with the frequencies for all octaves.
  274. My brother was appalled at such wasteful coding, and insisted on
  275. figuring out a formula to do it from the known octave.  I call his
  276. effort The Formula From Hell.  It works just fine, though. *)
  277.  
  278. for Count := 0 to 6 do begin
  279.   Power := 1;
  280.   for Multiplier := 0 to Count-1 do Power := Power *2;
  281.   Divisor := 16.0 / Power;
  282.   for SemiTone := 0 to 11 do
  283.   Pitch[Semitone+Base[Count]] := MakeLong(trunc(frac(Herz[SemiTone]/Divisor)),
  284.                                           trunc(int(Herz[SemiTone]/Divisor)));
  285.   end;
  286.  
  287. (*
  288. That MakeLong(trunc(frac( and trunc(int( stuff is necessary because
  289. Windows wants the fractional and integer portions of the frequency
  290. stuffed respectively into the low and high words of a long integer.
  291. Strange. *)
  292.  
  293. (*
  294. setVoiceSound doesn't provide for a rest.  Instead, I've plugged an
  295. impossibly high pitch into the [0] slot of that array.  It's
  296. presumably playing, but you shouldn't hear it. *)
  297.  
  298. Pitch[0] := MakeLong(0,20000);
  299.  
  300. end.
  301.  
  302. (*
  303. There's no error checking built into any of this.  It didn't seem very
  304. necessary.  Much of the time, a nonsense value in the play string will
  305. just fall on through and be ignored.  Something like a T not followed
  306. by a valid number will cause a run time error message, but I figure
  307. the programmer is going to catch that sort of thing -- it will never
  308. impact the end user.
  309.  
  310. Additionally, I didn't fiddle with the size of the "voice queue."
  311. There are API calls to tweak it.  If you write an unusually long
  312. string, the last portion may fail to play.  There's really no reason
  313. to write such a long string, though.  Break long strings into short
  314. ones that fit neatly on the screen in the TPW editor.  You'll probably
  315. never run out of queue space.
  316.  
  317. Don Phillip Gibson
  318. 910 East 11th
  319. Winfield, KS 67156
  320.  
  321. CompuServe [75725,1752]
  322.  
  323. December 17, 1991
  324. *)
  325.  
  326.